home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 2: CDPD 1
/
Almathera Ten on Ten - Disc 2: CDPD 1.iso
/
pd
/
276-300
/
288
/
plotdata2d
/
plotdata2d.for
< prev
next >
Wrap
Text File
|
1995-03-14
|
150KB
|
3,353 lines
Program PlotData2D
C
C======================================================================C
C C
C PlotData2D - two-dimensional data plotting package C
C C
C======================================================================C
C C
C Author: Robert C. Singleterry Jr. C
C Home Address: School Address: C
C 365 Carol Ave. 1526 N. Santa Rita C
C Idaho Falls, ID 83401 Tucson, AZ 85719 C
C C
C Origin Date: 11/01/89 C
C Lastest Update: 11/01/89 C
C Current Revision: 1.0 C
C Language: AC/FORTRAN V2.3 C
C (need this compiler to recompile the program) C
C C
C======================================================================C
C C
C Purpose: C
C C
C This program plots data onto a custom user defined screen and C
C window using standard Amiga functions from AC/FORTRAN V2.3. C
C The plot and screen/window definitions along with the (X,Y) C
C data pairs are read in from a disk file. In this revision, C
C the disk file name is input through the command line C
C interface. The package supports linear, log-log, and C
C semi-log axis plots. The data can be plotted with lines, C
C symbols, or lines and symbols. As of now, all plots on one C
C screen must be the same. See the examples on the C
C distribution disk on exactly how to set up your data file. C
C Preambles are included for the three axis types; however, C
C the other options are what I use most often, which maybe C
C the exact opposite of what you need. C
C C
C Many "extras" have been included: C
C C
C * Automatic axis size determination with some extra room C
C * Border between the data and the axis C
C * Ability to access the screen depth gadget C
C * User defined Screen and Window dimensions C
C * Automatic value labeling on both axis C
C * User defined axis labels and plot title C
C * All border values are user defined C
C * Draws the coordinate axis on the graph C
C C
C Many "extras" will be include soon (see wish list). Hopefully C
C another revision will be out before Jan. 1 1990!! (I also C
C have to get my Master's thesis approved by then, so...). C
C C
C This release is the basis to work from. It is not intended C
C to be a final release. Please, if you have any comments, C
C complaints, bugs, code, etc..., write me!! Thanks. C
C C
C Also, I am not too sure about what must be done to release C
C this program to the general public? AC/FORTRAN runtime C
C library package problems. However, I do know for a fact that C
C using any or all of this program in a for-profit package will C
C get you a visit from me and my BIG brother. If you would like C
C to use any or all of this package in a public domain type C
C program, remember to place somewhere in your program who C
C actually sweated out the code!!! Thanks C
C C
C======================================================================C
C C
C Usage: C
C C
C 1> alias pd execute <volume:directory>plotdata2d.com C
C 1> pd <filename> C
C 1> pd h (to get help) C
C C
C Note - DO NOT press <ctrl-C>. To exit the program, activate C
C the CLOSEWINDOW gadget. Also do not execute the C
C program directly. Your individual stack size may not C
C be large enough and a visit from the GURU may be next C
C on the your hit parade. C
C C
C======================================================================C
C C
C Data Input: C
C C
C Command line: Data file name C
C C
C Data file name: The data layout is as follows: C
C C
C 1 - Screen height C
C 2 - Screen width C
C 3 - Window height C
C 4 - Window width C
C 5 - Window title (80 characters) C
C 6 - X axis label (60 characters) C
C 7 - Y axis label (60 characters) C
C 8 - Left, Right, Top, Bottom axis offset from edge of window C
C 9 - Left, Right, Top, Bottom plot offset from item 8 C
C 10 - User maximum refinement value C
C 11 - User minimum refinement value C
C 12 - Grid flag -> 0: No grid lines, 1: Grid lines C
C 13 - Plot type -> 0: Linear, 1: Log, 2: Semilog C
C 14 - Symbol flag -> 0: No symbols, 1: Symbols C
C 15 - Line flag -> 0: No lines, 1: Draw lines C
C 16 - Data Seperator -> The number that is used to C
C seperate the lines from one another C
C 17 - Plot data in X Y pairs with the plot lines C
C seperated by data item 16 C
C C
C======================================================================C
C C
C Variables: C
C C
C Integer C
C s_h - User input - screen height in pixels. C
C s_w - User input - screen width in pixels. C
C s_d - Screen depth (# of colors available for output) which C
C is determined at runtime. C
C w_h - User input - window height in pixels. The top-left C
C edge is hardcoded at (0,1), so a value of 400 in C
C interlace mode is okay. C
C w_w - User input - window width in pixels. C
C lefoff - User input - offset between the left edge of the C
C window and the left axis in pixels. C
C rigoff - User input - offset between the right edge of the C
C window and the right axis in pixels. C
C topoff - User input - offset between the top edge of the C
C SCREEN and the top axis in pixels. C
C botoff - User input - offset between the bottom of the C
C window and the bottom axis in pixels. C
C user_max - User input - refines the distance between the top C
C of the maximum point and the border of the plot. C
C user_min - User input - refines the distance between the bottomC
C of the maximum point and the border of the plot. C
C grid - User input - flag for use of grid line: 0 - No, 1 - Yes C
C xtype - Determined from user input - plot type of the X axis: C
C 0 - Linear, 1 - Log. C
C ytype - Determined from user input - plot type of the Y axis: C
C 0 - Linear, 1 - Log. C
C symdraw - User input - Flag to determine whether to draw C
C symbols at the data points or not: 0 - No, 1 - Yes. C
C line - Determined from user input - number of lines to plot. C
C pts - Determined from user input - number of points per line. C
C linedraw - Determined from user input - flag to determine C
C whether to draw a line between points or not: C
C 0 - No, 1 - Yes. C
C RP - Raster port pointer. C
C pixels - The pixel locations of the tick marks. C
C p_loff - The offset between the left edge and the left C
C plot boundary in pixels. C
C p_roff - The offset between the right axis and the right C
C plot boundary in pixels. C
C p_toff - The offset between the top axis and the top C
C plot boundary in pixels. C
C p_boff - The offset between the bottom axis and the bottom C
C plot boundary in pixels. C
C gridline - The color number of the grid lines. C
C lefpt - User input - the number of pixels between the left C
C axis and left plot boundary. C
C rigpt - User input - the number of pixels bewteen the right C
C axis and the right plot boundary. C
C toppt - User input - the number of pixels between the top C
C axis and the top plot boundary. C
C botpt - User input - the number of pixels between the bottom C
C axis and the bottom plot boundary. C
C Window - The address of the window structure. C
C Screen - The address of the screen structure. C
C i - Do loop indexing variable. C
C j - Do loop indexing variable. C
C Error - A variables to hold the error number returned from C
C a subroutine. C
C C
C Integer*1 C
C Errval - A byte variable used to hold integer or real error C
C return values. C
C C
C Integer*4 C
C Ierr - The integer return error value - see Errval. C
C C
C Real C
C MaxX - The maximum X value. C
C MaxY - The maximum Y value. C
C MinX - The minimum X value. C
C MinY - The minimum Y value. C
C dsep - User input - the line data seperator value. C
C X - User input - the X coordinate data. C
C Y - User input - the Y coordinate data. C
C values - The values of the tick marks. C
C SF - Scale factor - not used in this revision. C
C user_max - User input - A refinement value for the distance C
C between the top of the maximum point and the top of C
C the plot. C
C user_min - User input - A refinement value for the distance C
C between the bottom of the minimum point and the bottom C
C of the plot. C
C C
C Real*4 C
C Rerr - The real error return value - see Errval C
C C
C Character C
C s_tit - The screen title - hardcoded C
C w_tit - User input - the window title. C
C x_lab - User input - the X axis label. C
C y_lab - User input - the Y axis label. C
C filename - User input - the file name of the user input file C
C C
C Parameters (Integer) C
C YES - value = 1 C
C NO - value = 0 C
C LINEAR - value = 0 C
C LOG - value = 1 C
C SEMILOG - value = 2 C
C XAXIS - value = 0 C
C YAXIS - value = 1 C
C SEXP - The smallest exponent looked at in the log axis C
C expansion. C
C LEXP - The largest exponent looked at in the log axis C
C expansion. C
C MAXVAL - The maximum number of tick marks allowed. C
C MAXPAIRS - The maximum number of data pairs allowed. C
C TKMK - The pixel length of a tick mark. C
C SYMSIZE - The pixel length of a symbol. C
C C
C Commons C
C ScrnData -> C
C s_h, s_w, s_d, w_h, w_w, lefoff, rigoff, topoff, botoff, grid, C
C xtype, ytype, dsep, MaxX, MaxY, MinX, MinY, symdraw, linedraw, C
C p_loff, p_roff, p_toff, p_boff, user_max, user_min, gridline, C
C RP, lefpt, rigpt, toppt, botpt, s_tit, w_tit, x_lab, y_lab C
C C
C Plotdata -> C
C X, Y, line, pts C
C C
C MarkData -> C
C SF, values, pixels C
C C
C======================================================================C
C C
C Amiga Subprograms: C
C C
C IntuitionBase - Determines the base address of the Intuition C
C library. C
C GfxBase - Determines the base address of the graphics library. C
C Wait - Exec routine that is used in this program to wait C
C until the closewindow gadget is activated. C
C CloseWindow - This closes the open window. C
C CloseScreen - This closes the open screen. C
C ShowTitle - This is used to put the screen title behind the C
C window title on the backdrop screen. C
C SetRGB4 - This places a (red,green,blue) data triplet into C
C the current color table of the new screen C
C SetAPen - This set the A pen color to the color indicated in C
C the color table. C
C SetBPen - This sets the B pen color to the color indicated in C
C the color table. C
C SetDrMd - This sets the drawing mode. C
C Move - This moves the graphics cursor to the specified C
C coordinates. C
C Draw - This draws from the current graphics cursor position C
C to the indicated coordinates. C
C Text - This places text in the window at the indicated cursor C
C position. C
C C
C Internal Subprograms: C
C C
C DataRead - This reads and slightly processes the data in the C
C disk file name. C
C ScrnDepth - The determines the screen depth needed to support C
C the number of lines read in. C
C DataGen - The generates any data needed. C
C NewScreen - This creates the custom screen. C
C NewWindow - This creates the backdrop window where the plot C
C will appear. C
C MaxMin - This finds the maximum and minimum data values read C
C in from the data file. C
C InitPlot - This initialize the plot surface - Axis, Grid C
C lines, Tick marks, Value labels, Titles, etc.... C
C Plot - This plots one lines worth of data. C
C LinTickMark - This determines the tick marks for the C
C expanded plot axis for linear data. C
C LogTickMark - This determines the tick marks for the C
C expanded plot axis for log data. C
C DrawLabels - This draws the axis data vlaue labels. C
C DrawGrid - This draws the grid lines. C
C SymbolDraw - This draws the symbols at each point. C
C DrawTicks - This draws the tick marks onto the plot. C
C C
C External Subprograms: C
C C
C ARGS - An AC/FORTRAN subprogram that reads the command line C
C and stores it in a character string. C
C amiga - An AC/FORTRAN subprogram that allows AMIGA function C
C calls from FORTRAN. C
C loc - An AC/FORTRAN subprogram that assigns the ADDRESS of C
C the argument to the variable. C
C f77.rl - The AC/FORTRAN runtime library. C
C C
C======================================================================C
C C
C Error detection and recovery: C
C C
C An Error flag is set if an error occured and the program task C
C is immediately exited. Upon returning to the main program, C
C the corresponding error message is written and what ever is C
C opened is closed. Then the program exits. A real or C
C integer error value is passed back to the main program to C
C allow some diagnostic data in the error message. C
C C
C======================================================================C
C C
C Revision History: C
C C
C Original Release: 11/01/89 - Revision 1.0 C
C C
C UPDATES -> C
C Date: Initials: Remark or Task: C
C C
C======================================================================C
C C
C Known Bugs: C
C C
C Revision 1.0 - none C
C C
C======================================================================C
C C
C Upcomming Updates (Wish List) not in any order: C
C C
C - Axis labels self truncating. Make axis value labels only C
C show as many digitis as needed and still center on C
C tick mark C
C C
C - Ability to update colors, screen depth, and symbols used C
C from user input C
C C
C - Ability to mix data plot types, e.g., scatter and lines on C
C one plot C
C C
C - Addition of numerical analysis techniques to smooth the C
C plotted lines C
C C
C - Addition of regression (etc...) techniques to plot the best C
C curve through the given points C
C C
C - Addition of error bars on the data points used in the C
C regression techniques mentioned above C
C C
C - Addition of a legend to identify the lines drawn C
C C
C - Make all data items available to the menu for user C
C adjustment while the program is executing C
C C
C - Make data acquision of data pairs dynamic C
C C
C - Create a menu driven program to generate input files C
C C
C - Major revision to allow this package to render 3D surfaces C
C and volumes. Change name to PlotData3D C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C exec.inc - include file for exec kernal library functions C
C graph.inc - include file for graphics library functions C
C intuit.inc - include file for intuition library functions C
C plotdata.inc - include file for plotdata common data C
C======================================================================C
C
Include include:exec.inc
Include include:intuit.inc
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 Window, Screen, i, j
C
C======================================================================C
C Character variables C
C======================================================================C
C
Character
1 filename*255
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
Real*4 Rerr
Integer*1 Errval(4)
Equivalence
1 ( Errval(1), Ierr ),
2 ( Errval(1), Rerr )
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 Error / 0 /,
2 Errval / 4*0 /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Get the filename from the command line C
C======================================================================C
C
Call ARGS ( filename )
C
C======================================================================C
C Check for help symbol C
C======================================================================C
C
If ( filename(1:1) .eq. 'h' .or. filename(1:1) .eq. 'H' ) Then
Write ( *, 2000 )
Go To 9990
End If
C
C======================================================================C
C Set up the screen title C
C======================================================================C
C
s_tit = 'PlotData2D: General Plotting Package 1.0 by Robert ' //
1 'Singleterry - 11/01/89' // char(0)
C
C======================================================================C
C Read the specific data for the plot - Labels, title, data, etc.... C
C======================================================================C
C
Call DataRead ( filename, Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else If ( Error .eq. 1 ) Then
Write ( *, 9160 ) Ierr
Go To 9990
Else If ( Error .eq. 2 ) Then
Write ( *, 9240 ) Ierr
Go To 9990
Else If ( Error .eq. 3 ) Then
Write ( *, 9000 ) Ierr
Go To 9990
Else If ( Error .eq. 4 ) Then
Write ( *, 9260 ) Ierr
Go To 9990
Else If ( Error .eq. 5 ) Then
Write ( *, 9040 ) Ierr
Go To 9990
Else
Write ( *, 9020 ) Error, 'DataRead'
Go To 9990
End If
C
C======================================================================C
C Find the depth of the screen to hold all of the lines being plotted C
C======================================================================C
C
Call ScrnDepth ( Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else
Write ( *, 9020 ) Error, 'ScrnDepth'
Go To 9997
End If
C
C======================================================================C
C Perform any data adjustment that is necessary C
C Find the size of the plot area C
C If a regression is needed, find the lines to plot C
C======================================================================C
C
Call DataGen ( Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else
Write ( *, 9020 ) Error, 'DataGen'
Go To 9997
End If
C
C======================================================================C
C Initial set up of displays: C
C Find IntuitionBase C
C Find GfxBase C
C======================================================================C
C
Call amiga ( IntuitionBase )
If ( IntuitionBase .eq. 0 ) Then
Write ( *, 9060 )
Go To 9990
End If
C
Call amiga ( GfxBase )
If ( GfxBase .eq. 0 ) Then
Write ( *, 9080 )
Go To 9990
End If
C
C======================================================================C
C Open new screen C
C======================================================================C
C
Call NewScreen ( Screen, Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else If ( Error .eq. 1 ) Then
Write ( *, 9100 ) Ierr
Go To 9990
Else If ( Error .eq. 2 ) Then
Write ( *, 9200 ) Ierr
Go To 9990
Else If ( Error .eq. 3 ) Then
Write ( *, 9220 ) Ierr
Go To 9990
Else
Write ( *, 9020 ) Error, 'NewScreen'
Go To 9990
End If
C
C======================================================================C
C Open new window C
C======================================================================C
C
Call NewWindow ( Screen, Window, Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else If ( Error .eq. 1 ) Then
Write ( *, 9120 ) Ierr
Go To 9995
Else
Write ( *, 9020 ) Error, 'NewWindow'
Go To 9995
End If
C
C======================================================================C
C Find the maximum and minimum x and y values C
C======================================================================C
C
Call MaxMin ( Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else
Write ( *, 9020 ) Error, 'MaxMin'
Go To 9997
End If
C
C======================================================================C
C Draw X and Y axis, axis labels, tick marks, data labels, grids, etc C
C======================================================================C
C
Call InitPlot ( Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else If ( Error .eq. 1 ) Then
Write ( *, 9140 ) Rerr
Go To 9997
Else If ( Error .eq. 2 ) Then
Write ( *, 9280 ) Rerr
Go To 9997
Else If ( Error .eq. 3 ) Then
Write ( *, 9300 ) Ierr
Go To 9997
Else If ( Error .eq. 4 ) Then
Write ( *, 9320 )
Go To 9997
Else If ( Error .eq. 5 ) Then
Write ( *, 9340 ) Ierr
Go To 9997
Else If ( Error .eq. 6 ) Then
Write ( *, 9180 ) Ierr
Go To 9997
Else If ( Error .eq. 7 ) Then
Write ( *, 9380 ) Ierr
Go To 9997
Else If ( Error .eq. 8 ) Then
Write ( *, 9400 ) Ierr
Go To 9997
Else
Write ( *, 9200 ) Error, 'InitPLot'
Go To 9997
End If
C
C======================================================================C
C Plot all lines C
C======================================================================C
C
Do ( i = 1, line )
Call Plot ( i, Error, Errval )
If ( Error .eq. 0 ) Then
Continue
Else If ( Error .eq. 1 ) Then
Write ( *, 9360 ) Ierr
Go To 9997
Else
Write ( *, 9020 ) Error, 'Plot'
Go To 9997
End If
End Do
C
C======================================================================C
C Wait until the user closes the window C
C======================================================================C
C
Call amiga ( Wait,
1 shift ( 1, byte ( long(Window+wd_UserPort) + MP_SIGBIT ) ) )
C
C======================================================================C
C Execute all exit routines C
C======================================================================C
C
9999 Continue
C
C======================================================================C
C Close the window C
C======================================================================C
C
9997 Continue
Call amiga ( CloseWindow, Window )
C
C======================================================================C
C Close the screen - Open new window failure C
C======================================================================C
C
9995 Continue
Call amiga ( CloseScreen, Screen )
C
C======================================================================C
C Execute proper stop message C
C======================================================================C
C
9990 Continue
If ( Error .eq. 0 ) Then
Stop 'FORTRAN STOP'
Else
Stop 'FORTRAN ABORT'
End If
C
C======================================================================C
C Format statements C
C======================================================================C
C
2000 Format ( 'PlotData2D Package help output:', /,
2 'Input file specification', /, ' 1 - Screen height', /,
3 ' 2 - Screen width', /, ' 3 - Window height', /,
4 ' 4 - Window width', /, ' 5 - Window title (80 characters)',/,
5 ' 6 - X axis label (60 characters)', /,
6 ' 7 - Y axis label (60 characters)', /,
7 ' 8 - Left, Right, Top, Bottom axis offset from edge of ',
8 'window', /,
9 ' 9 - Left, Right, Top, Bottom plot offset from item 8', /,
1 ' 10 - User inputed maximum refinement value', /,
1 ' 11 - User inputed minimum refinement value', /,
2 ' 12 - Grid flag -> 0: No grid lines, 1: Grid lines', /,
3 ' 13 - Plot type -> 0: Linear, 1: Log, 2: Semilog', /,
4 ' 14 - Symbol flag -> 0: No symbols, 1: Symbols', /,
5 ' 15 - Line flag -> 0: No lines, 1: Draw lines', /,
6 ' 16 - Data Seperator -> A number to seperate the lines', /,
7 ' 17 - Data in X Y pairs with the lines seperated by data ',
8 'item 15', //,
9 'alias pd <vol:dir>PlotData2D []', /, 'pd <filename>', /,
2 'pd h - for this help file' )
C
9000 Format ( '***** Error: One point found to plot for line ', i3 )
9020 Format ( '***** Error: Undefined Error = ', i3.3,
1 ' for routine ', a )
9040 Format ( '***** Error: The plot type read is invalid: ', i2 )
9060 Format ( '***** Error: IntuitionBase failure' )
9080 Format ( '***** Error: GfxBase failure' )
9100 Format ( '***** Error: Could not create new screen = ', i10 )
9120 Format ( '***** Error: Could not create new window = ', i10 )
9140 Format ( '***** Error: Minimum value of ', e15.5, ' is below ',
1 'the default value used to search for bottom of scale')
9160 Format ( '***** Error: Could not open data file, iostat = ',
1 i10 )
9180 Format ( '***** Error: Invalid y-axis plot type used: ', i4 )
9200 Format ( '***** Error: Invalid screen width: ', i5 )
9220 Format ( '***** Error: Invalid screen height: ', i5 )
9240 Format ( '***** Error: Exceeded maximum number of ',
1 'point pairs allowed: ', i6 )
9260 Format ( '***** Error: Exceeded the number of lines allowed: ',
1 i5 )
9280 Format ( '***** Error: Maximum value of ', e15.5, ' is above ',
1 'the default values used to search for top of scale' )
9300 Format ( '***** Error: Invalid x-axis plot type used: ', i4 )
9320 Format ( '***** Error: Number of tick mark algorithm failed ',
1 'in LinTickMark rotuine')
9340 Format ( '***** Error: Invalid Axis used: ', i4 )
9360 Format ( '***** Error: Invalid symbol value: ', i4 )
9380 Format ( '***** Error: Number of tick marks too large:', i6 )
9400 Format ( '***** Error: Invalid axis type passed to DrawLabels: '
1 i4 )
C
C======================================================================C
C End of program C
C======================================================================C
C
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine NewScreen ( Screen, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram creates a new screen to the user's C
C specifications. It should support all sizes inputted into C
C it, including PAL sizes, but with out a PAL machine, I have C
C not tested it. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer C
C Screen - The address of the screen structure. C
C vm - The view mode flag. This is defined at runtime from user C
C input. C
C Error - The error flag set by different errors. C
C Ierr - An integer value returned when an error occurs. C
C amiga - An AC/FORTRAN subprogram to allow access to the AMIGA C
C kernal functions. C
C loc - The stores the address of the argument, not the value. C
C C
C Character C
C Font - The name of the font used. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => OpenScreen failure. C
C Error = 2 => The screen width is less than 320 pixels. C
C Error = 3 => The screen height is less than 200 pixels. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:intuit.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 Screen, amiga, loc, vm
C
C======================================================================C
C Character variables C
C======================================================================C
C
Character
1 Font*11
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C======================================================================C
C Saved variables C
C======================================================================C
C
Save NewScreen
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Define text attribute structure C
C======================================================================C
C
Font = 'topaz.font' // char(0)
ta_Name = loc ( Font )
ta_YSize = 8
ta_Style = FS_NORMAL
ta_Flags = FP_ROMFONT
C
C======================================================================C
C Define the view modes attributes C
C======================================================================C
C
vm = 0
C
If ( s_w .ge. 640 ) Then
vm = vm .or. HIRES
Else If ( s_w .lt. 320 ) Then
Error = 2
Ierr = s_w
Go To 9999
End If
C
If ( s_h .ge. 400 ) Then
vm = vm .or. LACE
Else If ( s_h .lt. 200 ) Then
Error = 3
Ierr = s_h
Go To 9999
End If
C
C======================================================================C
C Define the new screen structure C
C======================================================================C
C
ns_LeftEdge = 0
ns_TopEdge = 0
ns_Width = s_w
ns_Height = s_h
ns_Depth = s_d
ns_DetailPen = 1
ns_BlockPen = 0
ns_ViewModes = vm
ns_Type = CUSTOMSCREEN
ns_Font = loc ( TextAttr )
ns_DefTitle = loc ( s_tit )
ns_Gadgets = 0
ns_CustBitMap = 0
C
C======================================================================C
C Open the new screen C
C======================================================================C
C
Screen = amiga ( OpenScreen, NewScreen )
If ( Screen .eq. 0 ) Then
Error = 1
Ierr = Screen
Go To 9999
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine NewWindow ( Screen, Window, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram creates a new backdrop active window to plot C
C on. This window is on the screen pointed to by the Screen C
C argument. This subprogram then defines the color table used C
C by the plotting package. The window is created at a fixed C
C poistion (0,1) to allow access to the screen's depth gadget. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer C
C Window - The address of the window structure. C
C Screen - The address of the screen structure from the C
C NewScreen subprogram. C
C vp - Address of the veiwport data structure for use by C
C SetRGB4. C
C Error - The error flag used to signal errors. C
C Ierr - An integer error return value. C
C amiga - An AC/FORTRAN subprogram that allows use of the AMIGA C
C kernal functions. C
C loc - This stores the address of the argument rather than C
C the value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => An OpenWindow function failure. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:intuit.inc
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 amiga, loc, Window, Screen, vp
C
C======================================================================C
C Saved variables C
C======================================================================C
C
Save NewWindow
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Defining the new window structure C
C======================================================================C
C
nw_LeftEdge = 0
nw_TopEdge = 1
nw_Width = w_w
nw_Height = w_h - 1
nw_DetailPen = 1
nw_BlockPen = 0
nw_Title = loc ( w_tit )
nw_Flags = WINDOWCLOSE .or. BORDERLESS .or. ACTIVATE
1 .or. BACKDROP
nw_IDCMPFlags = CLOSEWINDOW
nw_Type = CUSTOMSCREEN
nw_FirstGdgt = 0
nw_CheckMark = 0
nw_Screen = Screen
nw_BitMap = 0
nw_MinWidth = -1
nw_MinHeight = -1
nw_MaxWidth = -1
nw_MaxHeight = -1
C
C======================================================================C
C Open the new window C
C======================================================================C
C
Window = amiga ( OpenWindow, NewWindow )
If ( Window .eq. 0 ) Then
Error = 1
Ierr = Window
Go To 9999
End If
C
C======================================================================C
C Place the screen title behind the backdrop window title C
C======================================================================C
C
Call amiga ( ShowTitle, Screen, 0 )
C
C======================================================================C
C Define the raster port pointer C
C======================================================================C
C
RP = long ( Window + wd_RPort )
C
C======================================================================C
C Define the view port pointer C
C======================================================================C
C
vp = amiga ( ViewPortAddress, Window )
C
C======================================================================C
C Set up the color table C
C Color Table Number Red Green Blue Color C
C 00 0 0 0 black C
C 01 F F F white C
C 02 F 0 0 red C
C 03 0 F 0 green C
C 04 0 0 F blue C
C 05 F F 0 lemmon yellow C
C 06 6 C E lt blue C
C 07 F A C pink C
C 08 B F 0 lime green C
C 09 A 8 7 brown C
C 10 9 1 F purple C
C 11 F 9 0 orange C
C 12 2 C 0 dark green C
C 13 F D 0 cadmium yellow C
C 14 D 0 0 brick red C
C 15 C 1 F violet C
C 16 F D 7 C
C 17 F F F white C
C 18 F 0 0 red C
C 19 0 F 0 green C
C 20 0 0 F blue C
C 21 F F 0 lemmon yellow C
C 22 6 C E lt blue C
C 23 F A C pink C
C 24 B F 0 lime green C
C 25 A 8 7 brown C
C 26 9 1 F purple C
C 27 F 9 0 orange C
C 28 2 C 0 dark green C
C 29 F D 0 cadmium yellow C
C 30 D 0 0 brick red C
C 31 C 1 F violet C
C======================================================================C
C
Call amiga ( SetRGB4, vp, 00, 00, 00, 00 )
Call amiga ( SetRGB4, vp, 01, 15, 15, 15 )
Call amiga ( SetRGB4, vp, 02, 15, 00, 00 )
Call amiga ( SetRGB4, vp, 03, 00, 15, 00 )
Call amiga ( SetRGB4, vp, 04, 00, 00, 15 )
Call amiga ( SetRGB4, vp, 05, 15, 15, 00 )
Call amiga ( SetRGB4, vp, 06, 06, 12, 14 )
Call amiga ( SetRGB4, vp, 07, 15, 10, 12 )
Call amiga ( SetRGB4, vp, 08, 11, 15, 00 )
Call amiga ( SetRGB4, vp, 09, 10, 08, 07 )
Call amiga ( SetRGB4, vp, 10, 09, 01, 15 )
Call amiga ( SetRGB4, vp, 11, 15, 09, 00 )
Call amiga ( SetRGB4, vp, 12, 02, 12, 00 )
Call amiga ( SetRGB4, vp, 13, 15, 13, 00 )
Call amiga ( SetRGB4, vp, 14, 13, 00, 00 )
Call amiga ( SetRGB4, vp, 15, 12, 01, 15 )
Call amiga ( SetRGB4, vp, 16, 15, 13, 07 )
Call amiga ( SetRGB4, vp, 17, 15, 15, 15 )
Call amiga ( SetRGB4, vp, 18, 15, 00, 00 )
Call amiga ( SetRGB4, vp, 19, 00, 15, 00 )
Call amiga ( SetRGB4, vp, 20, 00, 00, 15 )
Call amiga ( SetRGB4, vp, 21, 15, 15, 00 )
Call amiga ( SetRGB4, vp, 22, 06, 12, 14 )
Call amiga ( SetRGB4, vp, 23, 15, 10, 12 )
Call amiga ( SetRGB4, vp, 24, 11, 15, 00 )
Call amiga ( SetRGB4, vp, 25, 10, 08, 07 )
Call amiga ( SetRGB4, vp, 26, 09, 01, 15 )
Call amiga ( SetRGB4, vp, 27, 15, 09, 00 )
Call amiga ( SetRGB4, vp, 28, 02, 12, 00 )
Call amiga ( SetRGB4, vp, 29, 15, 13, 00 )
Call amiga ( SetRGB4, vp, 30, 13, 00, 00 )
Call amiga ( SetRGB4, vp, 31, 12, 01, 15 )
C
C======================================================================C
C Set the grid line color and place it into the color table C
C======================================================================C
C
gridline = int ( 2.0 ** float(s_d) ) - 1
If ( gridline .lt. 3 ) Then
gridline = 3
End If
Call amiga ( SetRGB4, vp, gridline, 5, 4, 5 )
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine InitPlot ( Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram initalizes the plotting screen. It sets up C
C pen colors and the drawing mode, draws the plot borders, puts C
C the axis labels on the plot, draws the tick marks, the axis C
C data labels, and the grid marks. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*2 C
C wline - The line pattern to draw the coordinate axis with C
C C
C Integer C
C ticks - A parameter to pass to the subprograms that tells C
C how many tick marks (or grid marks) to draw C
C pstart - The starting pixel to draw the coordinate axis from C
C pend - The ending pixel to draw the coordinate axis to C
C pval - the value of zero to draw the axis at C
C Error - The error flag C
C Ierr - The integer error value C
C Ierr1 - An integer error value that is indirectly passed to C
C the called subprograms C
C Errval1 - The storage area for the error values returned to C
C this subprogram C
C C
C Real C
C Rerr1 - A real error value that is indirectly passed to the C
C called subprograms C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => The smallest data value is below the tick mark C
C check limit C
C Error = 2 => The largest data value is above the tick mark C
C check limit C
C Error = 3 => The X axis type flag is not LINEAR or LOG C
C Error = 4 => Linear tick mark algorithm failure C
C Error = 5 => The Axis argument is no the X or the Y axis C
C Error = 6 => The Y axis type flag is not LINEAR or LOG C
C Error = 7 => The number of tick marks found is too large C
C Error = 8 => The plot type value passed to drawLabels is not C
C LINEAR or LOG C
C C
C======================================================================C
C
Implicit none
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer*2
1 wline
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 ticks, pstart, pend, pval
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr, Ierr1
Real*4 Rerr1
Integer*1 Errval1(4)
Equivalence ( Errval1(1), Ierr1 ), ( Errval1(1), Rerr1 )
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 wline / b'1111 1111 1111 1111' /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Setup the pen colors and drawing mode C
C======================================================================C
C
Call amiga ( SetAPen, RP, 1 )
Call amiga ( SetBPen, RP, 0 )
Call amiga ( SetDrMd, RP, JAM2 )
C
C======================================================================C
C Draw plotting axis and borders C
C======================================================================C
C
Call amiga ( Move, RP, lefoff-1, topoff-1 )
Call amiga ( Draw, RP, w_w-rigoff+1, topoff-1 )
Call amiga ( Draw, RP, w_w-rigoff+1, w_h-botoff )
Call amiga ( Draw, RP, lefoff-1, w_h-botoff )
Call amiga ( Draw, RP, lefoff-1, topoff-1 )
C
C======================================================================C
C Label Y axis C
C======================================================================C
C
Call amiga ( Move, RP, lefoff, topoff-3 )
Call amiga ( Text, RP, y_lab, len(y_lab) )
C
C======================================================================C
C Label the X axis C
C======================================================================C
C
Call amiga ( Move, RP, (w_w-len(x_lab))/2, w_h-3 )
Call amiga ( Text, RP, x_lab, len(x_lab) )
C
C======================================================================C
C Determine if X axis linear tick marks are to be drawn C
C======================================================================C
C
If ( xtype .eq. LINEAR ) Then
C
C======================================================================C
C If linear, then find and draw the tick marks C
C======================================================================C
C
Call LinTickMark ( XAXIS, MaxX, MinX, ticks,
1 Error, Errval1 )
If ( Error .ne. 0 ) Then
Ierr = Ierr1
Go To 9999
End If
C
C======================================================================C
C Determine if X axis log tick marks are to be drawn C
C======================================================================C
C
Else If ( xtype .eq. LOG ) Then
C
C======================================================================C
C If log, then find and draw the tick marks C
C======================================================================C
C
Call LogTickMark ( XAXIS, MaxX, MinX, ticks,
1 Error, Errval1 )
If ( Error .ne. 0 ) Then
Ierr = Ierr1
Go To 9999
End If
C
C======================================================================C
C If the type is not log or linear C
C======================================================================C
C
Else
C
C======================================================================C
C Signal an error and return C
C======================================================================C
C
Error = 3
Ierr = xtype
Go To 9999
C
End If
C
C======================================================================C
C Draw X axis value labels C
C======================================================================C
C
Call DrawLabels ( XAXIS, ticks, xtype, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
C======================================================================C
C Draw the grid marks if applicable C
C======================================================================C
C
If ( grid .eq. YES ) Then
C
Call DrawGrid ( XAXIS, ticks, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
End If
C
C======================================================================C
C Determine if Y axis linear tick marks are to be drawn C
C======================================================================C
C
If ( ytype .eq. LINEAR ) Then
C
C======================================================================C
C If linear, then find and draw the tick marks C
C======================================================================C
C
Call LinTickMark ( YAXIS, MaxY, MinY, ticks,
1 Error, Errval1 )
If ( Error .ne. 0 ) Then
Ierr = Ierr1
Go To 9999
End If
C
C======================================================================C
C Determine if Y axis log tick marks are to be drawn C
C======================================================================C
C
Else If ( ytype .eq. LOG ) Then
C
C======================================================================C
C If log, then find and draw the tick marks C
C======================================================================C
C
Call LogTickMark ( YAXIS, MaxY, MinY, ticks,
1 Error, Errval1 )
If ( Error .ne. 0 ) Then
Ierr = Ierr1
Go To 9999
End If
C
C======================================================================C
C If not linear or log C
C======================================================================C
C
Else
C
C======================================================================C
C Signal an error and return C
C======================================================================C
C
Error = 6
Ierr = ytype
Go To 9999
C
End If
C
C======================================================================C
C Draw Y axis value labels C
C======================================================================C
C
Call DrawLabels ( YAXIS, ticks, ytype, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
C======================================================================C
C Draw the grid marks if applicable C
C======================================================================C
C
If ( grid .eq. YES ) Then
C
Call DrawGrid ( YAXIS, ticks, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
End If
C
C======================================================================C
C Draw the Y coordinate axis if shown on graph C
C======================================================================C
C
If ((xtype.ne.LOG).and.(MinX.le.0.0).and.(MaxX.ge.0.0)) Then
pstart = w_h - botoff
pend = topoff
pval = int ( float(p_loff) +
1 ( -MinX * float((w_w-p_roff)-p_loff) / (MaxX-MinX) ) )
Call amiga ( SetAPen, RP, gridline )
word ( RP + 34 ) = wline
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
Call amiga ( Move, RP, pval, pstart )
Call amiga ( Draw, RP, pval, pend )
End If
C
C======================================================================C
C Draw the X coordinate axis if shown on graph C
C======================================================================C
C
If ((ytype.ne.LOG).and.(MinY.le.0.0).and.(MaxY.ge.0.0) ) Then
pstart = lefoff
pend = w_w - rigoff
pval = int ( float(w_h-p_boff) +
1 ( -MinY * float(p_toff-(w_h-p_boff)) / (MaxY-MinY) ) )
Call amiga ( SetAPen, RP, gridline )
word ( RP + 34 ) = wline
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
Call amiga ( Move, RP, pstart, pval )
Call amiga ( Draw, RP, pend, pval )
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine Plot ( ptln, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram plots a lines worth of data onto the window. C
C The line type, line color, and symbol color variables are C
C incremented when needed. These variables are saved so that C
C their values are not lost when the subroutine exits. C
C The SymbolDraw and Move/Draw subprogram calls are flagged so C
C that different type of plots can be drawn: line only, symbol C
C only, or line and symbols. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*2 C
C w_line - The bit pattern for the three line drawing types C
C C
C Integer C
C i - Do loop variable C
C color - The pallet number of the current color to draw C
C Xpix - The X pixel position as calculated C
C Ypix - The Y pixel position as calculated C
C linenum - The current index into w_line to determine which C
C line type to draw C
C ptln - The current number of the line in the data to draw C
C index - The index into the X and Y data C
C symbol - The current symbol number being drawn C
C Error - The returned error number (0 if no error) C
C C
C Integer*4 C
C Ierr - The error return value to print with error C
C C
C Real C
C constx - Temporary storage for the Xpix calculation C
C consty1 - Temporary storage for the Ypix calculation C
C consty2 - Temporary storage for the Ypix calcualtion C
C C
C Logical C
C First - Determination if this is the first time in this C
C subprogram C
C C
C Save C
C color, First, linenum, index, symbol C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => SymbolDraw Error - symbol number passed not valid C
C C
C======================================================================C
C
Implicit none
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer*2 variables C
C======================================================================C
C
Integer*2
1 w_line(3)
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 i, color, Xpix, Ypix, linenum, ptln, index, symbol
C
C======================================================================C
C Real variables C
C======================================================================C
C
Real
1 constx, consty1, consty2
C
C======================================================================C
C Logical variables C
C======================================================================C
C
Logical
1 First
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C======================================================================C
C Saved variables C
C======================================================================C
C
Save
1 color, First, linenum, index, symbol
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 First / .true. /,
2 w_line / b'1111 1111 1111 1111',
3 b'1111 0000 1111 0000',
4 b'1100 1100 1100 1100' /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C If this is the first call to this subprogram, then C
C Find the first color and line to use on the plot C
C======================================================================C
C
If ( First .eq. .true. ) Then
First = .false.
color = 1
linenum = 1
index = 0
symbol = 1
End If
C
C======================================================================C
C Set up the drawing pen color C
C======================================================================C
C
Call amiga ( SetAPen, RP, color )
C
C======================================================================C
C Place the line pattern into the proper data structure C
C======================================================================C
C
word ( RP + 34 ) = w_line(linenum)
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
C
C======================================================================C
C Calculate constants needed for the line C
C======================================================================C
C
constx = float ( w_w - p_roff - p_loff ) / ( MaxX - MinX )
consty1 = float ( p_toff + p_boff - w_h ) / ( MaxY - MinY )
consty2 = float ( w_h - p_boff )
C
C======================================================================C
C Increment the pointer into the data plotting structure C
C======================================================================C
C
index = index + 1
C
C======================================================================C
C Adjust data plotting values if necessary C
C======================================================================C
C
If ( xtype .eq. LOG ) Then
X(index) = alog10(X(index))
End If
If ( ytype .eq. LOG ) Then
Y(index) = alog10(Y(index))
End If
C
C======================================================================C
C Calculate the pixel positions of the first point C
C======================================================================C
C
Xpix = int ( float(p_loff) + ( ( X(index) - MinX ) * constx ) )
Ypix = int ( consty2 + ( ( Y(index) - MinY ) * consty1 ) )
C
C======================================================================C
C Draw the rest of the line C
C======================================================================C
C
Do ( i = 2, pts(ptln) )
C
C======================================================================C
C Draw the current symbol if necessary C
C======================================================================C
C
If ( symdraw .eq. YES ) Then
Call SymbolDraw ( symbol, Xpix, Ypix,
1 Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
End If
C
C======================================================================C
C Move to the current position calculated if necessary C
C======================================================================C
C
If ( linedraw .eq. YES ) Then
Call amiga ( Move, RP, Xpix, Ypix )
End If
C
C======================================================================C
C Increment the point into the data plotting structure C
C======================================================================C
C
index = index + 1
C
C======================================================================C
C Adjust the data values if necessary C
C======================================================================C
C
If ( xtype .eq. LOG ) Then
X(index) = alog10(X(index))
End If
If ( ytype .eq. LOG ) Then
Y(index) = alog10(Y(index))
End If
C
C======================================================================C
C Calculate the new positions of the the data point C
C======================================================================C
C
Xpix = int ( float(p_loff) + ((X(index)-MinX)*constx) )
Ypix = int ( consty2 + ((Y(index)-MinY)*consty1) )
C
C======================================================================C
C Set up the current line symbol C
C======================================================================C
C
word ( RP + 34 ) = w_line(linenum)
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
C
C======================================================================C
C Draw the line C
C======================================================================C
C
If ( linedraw .eq. YES ) Then
Call amiga ( Draw, RP, Xpix, Ypix )
End If
C
C======================================================================C
C End of loop over all points in the line C
C======================================================================C
C
End Do
C
C======================================================================C
C Draw the last symbol if necessary C
C======================================================================C
C
If ( symdraw .eq. YES ) Then
Call SymbolDraw ( symbol, Xpix, Ypix, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
End If
C
C======================================================================C
C Increment the line number and the color number for the next line. C
C Only increment the line draw type if the symbols are not being C
C drawn, otherwise the screen is too clutered to see the lines. C
C======================================================================C
C
color = color + 1
If ( color .ge. gridline ) Then
color = 1
If ( symdraw .eq. NO ) Then
linenum = linenum + 1
If ( linenum .gt. 3 ) Then
linenum = 1
End If
End If
End If
C
C======================================================================C
C Increment the symbol number on every pass C
C======================================================================C
C
symbol = symbol + 1
If ( symbol .gt. 4 ) Then
symbol = 1
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine LinTickMark ( Axis, max, min, oticks, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram determines the position of the tick marks to C
C be drawn on the screen. This subprogram also determines the C
C values associated with those tick marks. This algorithm is C
C setup for LINEAR type tick marks and expands the axis width C
C to accomodate the nearest magnitude. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Real C
C max - The maximum data value to use to calculate the relation C
C between the pixel value and the data value. C
C min - The minimum data vlaue to use to calculate the relation C
C between the pixel value and the data value. C
C v_Ran - The data value range or domain depending on the axis. C
C v_Mag - The magnitude used to normalize the range or domain. C
C check - The tick mark numbers to check. C
C tcheck - A temporary tick marks check value. C
C v_pix - Temporary real pixel values. C
C dval - The delta data value between tick marks. C
C dpix - the delta number of pixels per tick mark. C
C C
C Integer*4 C
C Ierr - The error return value. C
C C
C Integer C
C Axis - The axis value number. C
C p_Ran - The pixel range value. C
C i - Do loop index variable. C
C ticks - The number of tick marks generated from each check C
C against the optimum number of tick marks wanted. C
C opt_ticks - The optimum number of tick marks. C
C set - The index into the winning tick mark check. C
C oticks - The output number of tick marks. C
C Error - The return error value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 4 => Tick mark number generation algorithm failed. C
C Error = 5 => Invalid axis value. C
C Error = 7 => Number of tick marks greater than MAXVAL. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Real Variables C
C======================================================================C
C
Real
1 max, min, v_Ran, v_Mag, check(3), tcheck(3), dval,
2 v_pix(0:MAXVAL), dpix
C
C======================================================================C
C Integer Variables C
C======================================================================C
C
Integer
1 Axis, p_Ran, i, ticks(3), opt_ticks, set, oticks
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 check / 1.0, 2.0, 5.0 /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Calculates the range and magnitude range of the maxmimum and minimum C
C data points C
C======================================================================C
C
v_Ran = max - min
v_Mag = 10.0 ** ( int(alog10(v_Ran)) )
C
C======================================================================C
C If the data is within one magnitude, then go on - no adjustment C
C needed C
C======================================================================C
C
If ( v_Mag .eq. 0 ) Then
Go To 1000
End If
C
C======================================================================C
C Adjust the maximum and minimum value C
C======================================================================C
C
min = user_min * min / v_Mag
If ( min .lt. 0.0 ) Then
min = float ( int(min-0.99999) ) * v_Mag / user_min
Else
min = float ( int(min ) ) * v_Mag / user_min
End If
C
max = user_max * max / v_Mag
If ( max .lt. 0.0 ) Then
max = float ( int(max ) ) * v_Mag / user_max
Else
max = float ( int(max+0.99999) ) * v_Mag / user_max
End If
C
C======================================================================C
C Store the new maximum and minimum values into common C
C======================================================================C
C
1000 Continue
If ( Axis .eq. XAXIS ) Then
MaxX = max
MinX = min
Else If ( Axis .eq. YAXIS ) Then
MaxY = max
MinY = min
Else
Error = 5
Ierr = Axis
Go To 9999
End If
C
C======================================================================C
C Write output to console - user refinement purposes C
C======================================================================C
C
Write ( *, * ) 'Subroutine LinTickMark:'
If ( Axis .eq. XAXIS ) Then
Write( *, * )' Linear Tick Mark Generation for X axis'
Else If ( Axis .eq. YAXIS ) Then
Write( *, * )' Linear Tick Mark Generation for Y axis'
Else
Error = 5
Ierr = Axis
Go To 9999
End If
Write ( *, 100 ) ' New Max and Min values = ', max, ', ', min
C
C======================================================================C
C Find the pixel range C
C======================================================================C
C
If ( Axis .eq. XAXIS ) Then
p_Ran = w_w - p_loff - p_roff + 1
Else If ( Axis .eq. YAXIS ) Then
p_Ran = w_h - p_boff - p_toff + 1
Else
Error = 5
Ierr = Axis
Go To 9999
End If
C
C======================================================================C
C Find the new maximum and minimum range and magnitude values C
C======================================================================C
C
v_Ran = max - min
v_Mag = 10.0 ** ( nint(alog10(v_Ran)) - 1 )
C
C======================================================================C
C Set the optimum number of tick marks wanted C
C======================================================================C
C
opt_ticks = 10
C
C======================================================================C
C Determine the number of tick marks close to the optimum value C
C======================================================================C
C
Do ( i = 1, 3 )
tcheck(i) = check(i) * v_Mag
ticks(i) = nint ( v_Ran / tcheck(i) )
If ( opt_ticks .ge. ticks(i) ) Then
set = i
Go To 2000
End If
End Do
Error = 4
Go To 9999
C
C======================================================================C
C Check values of ticks and set up the value of the output value C
C======================================================================C
C
2000 Continue
If ( ticks(set) .gt. MAXVAL ) Then
Error = 7
Ierr = ticks(set)
Go To 9999
End If
oticks = ticks(set)
C
C======================================================================C
C Find the data values and pixel values determined from the above C
C analysis to draw the grid marks and tick marks C
C======================================================================C
C
dval = v_Ran / ticks(set)
values(0) = min
If ( Axis .eq. XAXIS ) Then
pixels(0) = p_loff
v_pix(0) = float(pixels(0))
dpix = float(p_Ran) / float(ticks(set))
Else If ( Axis .eq. YAXIS ) Then
pixels(0) = w_h - p_boff
v_pix(0) = float(pixels(0))
dpix = - float(p_Ran) / float(ticks(set))
Else
Error = 5
Ierr = Axis
Go To 9999
End If
Do ( i = 1, ticks(set) )
values(i) = values(i-1) + dval
v_pix(i) = v_pix(i-1) + dpix
pixels(i) = int ( v_pix(i) )
End Do
C
C======================================================================C
C Draw tick marks C
C======================================================================C
C
Call DrawTicks ( Axis, ticks(set), Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
C======================================================================C
C Format Statements C
C======================================================================C
C
100 Format ( a, 1pe15.6, a, 1pe15.6 )
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine LogTickMark ( Axis, max, min, oticks, Error, Errval )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram determines the position of the tick marks to C
C be drawn on the screen. This subprogram also determines the C
C values associated with those tick marks. This algorithm is C
C setup for LOG type tick marks and expands the axis width C
C to accomodate the nearest magnitude. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Real*4 C
C Rerr - The real return error value C
C C
C Real C
C max - The new maximum data value. C
C min - The new minimum data value. C
C adj_min - The new adjusted minimum value. C
C adj_max - The new adjusted maximum value. C
C log_max - The log10 of adj_max. C
C log_min - The log10 of adj_min. C
C dval - The delta data value used to calculate the tick marks. C
C const - A constant used in pixel tick mark data generation. C
C temp1 - A constant used in pixel tick mark data generation. C
C temp2 - A constant used in pixel tick mark data generation. C
C C
C Integer*1 C
C Errval - A equivalenced returned error value. C
C Ierrval - A equivalenced returned error value. C
C C
C Integer*4 C
C Ierr - The integer returned error value. C
C C
C Integer C
C Axis - The current axis value. C
C i - Do loop index variable. C
C j - Do loop index variable. C
C ticks - The number of tick marks being drawn. C
C v_Ranlog - The range or domain of the log10 of the max and min C
C indx - A pointer into the values array. C
C oticks - The output number of tick marks calculated. C
C Error - The error return value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => The data values are too small to be used. C
C Error = 2 => The data values are too large to be used. C
C Error = 5 => Invalid axis value passed. C
C Error = 7 => Too many tick marks calculated for memeory. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Real Variables C
C======================================================================C
C
Real
1 max, min, adj_min, adj_max, log_max, log_min, dval, const,
2 temp1, temp2
C
C======================================================================C
C Integer Variables C
C======================================================================C
C
Integer
1 Axis, i, j, ticks, v_Ranlog, indx, oticks
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
Real*4 Rerr
Integer*1 Errval(4), Ierrval(4)
Equivalence ( Rerr, Ierr ), ( Ierrval(1), Ierr )
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Find the minimum range for the data C
C======================================================================C
C
Do ( i = SEXP, LEXP )
If ( ( min .lt. (10.0**(i+1)) ) .and.
1 ( min .ge. (10.0**(i )) ) ) Then
adj_min = 10.0 ** (i)
Go To 500
End If
End Do
Error = 1
Rerr = min
Go To 9999
C
C======================================================================C
C Find the maximum range for the data C
C======================================================================C
C
500 Continue
Do ( i = SEXP, LEXP )
If ( ( max .le. (10.0**(i+1)) ) .and.
1 ( max .ge. (10.0**(i )) ) ) Then
adj_max = 10.0 ** (i+1)
Go To 1000
End If
End Do
Error = 2
Rerr = max
Go To 9999
C
C======================================================================C
C Find the maximum and minimum log values C
C======================================================================C
C
1000 Continue
log_max = alog10 ( adj_max )
log_min = alog10 ( adj_min )
C
C======================================================================C
C Find the new range to the nearest integer C
C======================================================================C
C
v_Ranlog = nint ( log_max ) - nint ( log_min )
C
C======================================================================C
C Store these values in the common area C
C======================================================================C
C
If ( Axis .eq. XAXIS ) Then
MaxX = log_max
MinX = log_min
Else If ( Axis .eq. YAXIS ) Then
MaxY = log_max
MinY = log_min
Else
Error = 5
Ierr = Axis
Go To 9999
End If
C
C======================================================================C
C Write output to console - user refinement purposes C
C======================================================================C
C
Write ( *, * ) 'Subroutine LogTickMark:'
If ( Axis .eq. XAXIS ) Then
Write ( *, * ) ' Log Tick Mark Generation for X axis'
Else If ( Axis .eq. YAXIS ) Then
Write ( *, * ) ' Log Tick Mark Generation for Y axis'
Else
Error = 5
Ierr = Axis
Go To 9999
End If
Write ( *, 100 ) ' New Max and Min values = ', adj_max, ', ',
1 adj_min
C
C======================================================================C
C Find the number of tickmarks and reject if larger than the size of C
C data arrays used below C
C======================================================================C
C
ticks = 9 * v_Ranlog
If ( ticks .gt. MAXVAL ) Then
Error = 7
Ierr = ticks
Go To 9999
End If
C
C======================================================================C
C Set up the output value C
C======================================================================C
C
oticks = ticks
C
C======================================================================C
C Find the data values for display C
C======================================================================C
C
values(0) = adj_min
Do ( i = 1, ticks/9 )
dval = values((i-1)*9)
Do ( j = 1, 9 )
indx = ( i - 1 ) * 9 + j
values(indx) = dval + ( float(j) * dval )
End Do
End Do
C
C======================================================================C
C Find the pixel values for display C
C======================================================================C
C
temp1 = alog10 ( values(0) )
temp2 = alog10 ( values(ticks) )
If ( Axis .eq. XAXIS ) Then
pixels(0) = p_loff
const = float (w_w-p_loff-p_roff) / (temp2-temp1)
Else If ( Axis .eq. YAXIS ) Then
pixels(0) = w_h - p_boff
const = float (p_toff+p_boff-w_h) / (temp2-temp1)
Else
Error = 5
Ierr = Axis
Go To 9999
End If
C
Do ( i = 1, ticks )
pixels(i) = int ( float(pixels(0)) +
1 ( (alog10(values(i))-temp1) * const ) )
End Do
C
C======================================================================C
C Draw tick marks C
C======================================================================C
C
Call DrawTicks ( Axis, ticks, Error, Ierr )
If ( Error .ne. 0 ) Then
Go To 9999
End If
C
C======================================================================C
C Setup error value output C
C======================================================================C
C
9999 Continue
If ( Error .ne. 0 ) Then
Do ( i = 1, 4 )
Errval(i) = Ierrval(i)
End Do
End If
C
C======================================================================C
C Format Statements C
C======================================================================C
C
100 Format ( a, 1pe15.6, a, 1pe15.6 )
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine DataRead ( filename, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram reads the input data file to determine the C
C plot specific parameters and plotting data. It does some C
C data verification, but not much. Could be updated. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*4 C
C Ierr - The error return value. C
C C
C Integer C
C type - The type of plot wanted by the user. Broken down into C
C plot axis type here. C
C index - A pointer into the data arrays. C
C i - Loop index variable. C
C Error - The error number. C
C C
C Character C
C filename - The data file name. Input through command line. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => filname does not exist C
C Error = 2 => Greater than MAXPAIRS data pairs. C
C Error = 3 => One data pair for the current line. C
C Error = 4 => Greater than MAXPAIRS/2 lines C
C Error = 5 => Plot type is not valid C
C C
C======================================================================C
C
Implicit none
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 type, index, i
C
C======================================================================C
C Character variables C
C======================================================================C
C
Character
1 filename*(*)
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Open data file C
C======================================================================C
C
Open ( unit=10, file=filename, status='old',
1 err=9900, iostat=Ierr )
Go To 1000
9900 Continue
Error = 1
Go To 9999
1000 Continue
C
C======================================================================C
C Read initial data from data file C
C======================================================================C
C
Read ( unit=10, fmt=* ) s_h, s_w, w_h, w_w, w_tit, x_lab,
1 y_lab, lefoff, rigoff, topoff, botoff, lefpt, rigpt, toppt,
2 botpt, user_max, user_min, grid, type, symdraw, linedraw, dsep
C
C======================================================================C
C Put a null character on the window title - a remnit from C strings C
C======================================================================C
C
w_tit(80:80) = char(0)
C
C======================================================================C
C Validate input C
C======================================================================C
C
If ( type .eq. LINEAR ) Then
xtype = LINEAR
ytype = LINEAR
Else If ( type .eq. LOG ) Then
xtype = LOG
ytype = LOG
Else If ( type .eq. SEMILOG ) Then
xtype = LINEAR
ytype = LOG
Else
Error = 5
Ierr = type
Go To 9999
End If
C
C======================================================================C
C Initialize linear arrays to dsep C
C======================================================================C
C
C Do ( i = 1, MAXPAIRS )
C X(i) = dsep
C Y(i) = dsep
C End Do
C
C======================================================================C
C Top of read loop C
C======================================================================C
C
line = 1
index = 1
5000 Continue
C
C======================================================================C
C Read all of the data in the file C
C Data seperated by a (dsep,dsep) data pair C
C======================================================================C
C
pts(line) = 1
Read ( unit=10, fmt=*, end=6000 ) X(index), Y(index)
C
Do While ( X(index) .gt. dsep .and. Y(index) .gt. dsep )
pts(line) = pts(line) + 1
index = index + 1
If ( index .gt. MAXPAIRS ) Then
Error = 2
Ierr = MAXPAIRS
Close ( unit=10 )
Go To 9999
End If
Read ( unit=10, fmt=* ) X(index), Y(index)
End Do
C
C======================================================================C
C Read data complete, take off (dsep,dsep) data pair C
C======================================================================C
C
pts(line) = pts(line) - 1
C
C======================================================================C
C Check to see if there is more than one point C
C======================================================================C
C
If ( pts(line) .le. 1 ) Then
Error = 3
Ierr = line
Close ( unit=10 )
Go To 9999
End If
C
C======================================================================C
C Increment line number C
C======================================================================C
C
Write ( *, 100 ) line, pts(line)
line = line + 1
If ( line .gt. MAXPAIRS/2 ) Then
Error = 4
Ierr = MAXPAIRS/2
Close(unit=10)
Go To 9999
End If
C
C======================================================================C
C Go to top of read data loop C
C======================================================================C
C
Go To 5000
C
C======================================================================C
C Close the data file C
C======================================================================C
C
6000 Continue
Close ( unit=10 )
C
C======================================================================C
C Decrement the line number for the last line C
C======================================================================C
C
line = line - 1
C
C======================================================================C
C Format statements C
C======================================================================C
C
100 Format ( 'Finished reading data for line ', i3.3, ' with the ',
1 'number of points = ', i4.4 )
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine MaxMin ( Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C To find the maximum and minimum X and Y values that are used C
C in various subprograms in this task. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*4 C
C Ierr - The return error value. C
C C
C Integer C
C i - Do loop variable. C
C j - Do loop variable. C
C index - Pointer into data arrays. C
C Error - The error return value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C No error check C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 i, j, index
C
C======================================================================C
C Error handling variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Set up the smallest values C
C======================================================================C
C
MaxX = X(1)
MaxY = Y(1)
MinX = X(1)
MinY = Y(1)
C
C======================================================================C
C Find the maximum and minimum values C
C======================================================================C
C
index = 0
C
C======================================================================C
C Loop over all values C
C======================================================================C
C
Do ( i = 1, line )
C
Do ( j = 1, pts(i) )
C
C======================================================================C
C Increment the index into the data structures C
C======================================================================C
C
index = index + 1
C
C======================================================================C
C Find the maximum X value C
C======================================================================C
C
If ( X(index) .gt. MaxX ) Then
MaxX = X(index)
End If
C
C======================================================================C
C Find the minimum X value C
C======================================================================C
C
If ( X(index) .lt. MinX ) Then
MinX = X(index)
End If
C
C======================================================================C
C Find the maximum Y value C
C======================================================================C
C
If ( Y(index) .gt. MaxY ) Then
MaxY = Y(index)
End If
C
C======================================================================C
C Find the minimum Y value C
C======================================================================C
C
If ( Y(index) .lt. MinY ) Then
MinY = Y(index)
End If
C
End Do
End Do
C
C======================================================================C
C Write output to the console - user refinement purposes C
C======================================================================C
C
Write ( *, * ) 'Subroutine MaxMin:'
Write ( *, * ) ' Data MaxX, MinX, MaxY, MinY = ',
1 MaxX, MinX, MaxY, MinY
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine ScrnDepth ( Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram determines the screen depth needed to hold C
C all the lines -- up to the maximum allowed anyway. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer C
C Error - The error return value. C
C C
C Integer*4 C
C Ierr - The return error value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C No error check C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Find the number of bit plans C
C======================================================================C
C
s_d = int ( alog10(float(line)) / alog10(2.0) ) + 1
C
C======================================================================C
C If it is only one, set it to two so grid lines can be drawn in a C
C different color, etc.... C
C======================================================================C
C
If ( s_d .le. 1 ) Then
s_d = 2
End If
C
C======================================================================C
C The maximum bit planes allowed for low resolution is 5 and the C
C maximum bit planes for high resolution is 4 C
C======================================================================C
C
If ( s_w .gt. 320 ) Then
If ( s_d .gt. 4 ) Then
s_d = 4
End If
Else If ( s_w .le. 320 ) Then
If ( s_d .gt. 5 ) Then
s_d = 5
End If
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine SymbolDraw ( symbol, Xpix, Ypix, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This draws the symbol on the data point. The symbol number C
C is passed from the calling program. The (X,Y) pixel data C
C is passed from the calling program. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*2 C
C w_line - The line pattern to draw the symbol with. C
C C
C Integer C
C symbol - The symbol number passed from the calling program. C
C Xpix - The X pixel value of the data point. C
C Ypix - The Y pixel value of the data point. C
C Error - The error return value. C
C C
C Integer*4 C
C Ierr - The return error value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 1 => Invalid symbol number C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer*2 variables C
C======================================================================C
C
Integer*2
1 w_line
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 symbol, Xpix, Ypix
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 w_line / b'1111 1111 1111 1111' /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Setup line type C
C======================================================================C
C
word ( RP + 34 ) = w_line
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
C
C======================================================================C
C Determine which symbol to draw: 1 - plus sign C
C======================================================================C
C
If ( symbol .eq. 1 ) Then
C
C======================================================================C
C Draw symbol - plus sign C
C======================================================================C
C
Call amiga ( Move, RP, Xpix, Ypix-SYMSIZE )
Call amiga ( Draw, RP, Xpix, Ypix+SYMSIZE )
Call amiga ( Move, RP, Xpix-SYMSIZE, Ypix )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix )
C
C======================================================================C
C Determine which symbol to draw: 2 - cross C
C======================================================================C
C
Else If ( symbol .eq. 2 ) Then
C
C======================================================================C
C Draw symbol - cross C
C======================================================================C
C
Call amiga ( Move, RP, Xpix-SYMSIZE, Ypix-SYMSIZE )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix+SYMSIZE )
Call amiga ( Move, RP, Xpix-SYMSIZE, Ypix+SYMSIZE )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix-SYMSIZE )
C
C======================================================================C
C Determine which symbol to draw: 3 - box C
C======================================================================C
C
Else If ( symbol .eq. 3 ) Then
C
C======================================================================C
C Draw symbol - box C
C======================================================================C
C
Call amiga ( Move, RP, Xpix-SYMSIZE, Ypix-SYMSIZE )
Call amiga ( Draw, RP, Xpix-SYMSIZE, Ypix+SYMSIZE )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix+SYMSIZE )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix-SYMSIZE )
Call amiga ( Draw, RP, Xpix-SYMSIZE, Ypix-SYMSIZE )
C
C======================================================================C
C Determine which symbol to draw: 4 - diamond C
C======================================================================C
C
Else If ( symbol .eq. 4 ) Then
C
C======================================================================C
C Draw symbol - diamond C
C======================================================================C
C
Call amiga ( Move, RP, Xpix, Ypix-SYMSIZE )
Call amiga ( Draw, RP, Xpix-SYMSIZE, Ypix )
Call amiga ( Draw, RP, Xpix, Ypix+SYMSIZE )
Call amiga ( Draw, RP, Xpix+SYMSIZE, Ypix )
Call amiga ( Draw, RP, Xpix, Ypix-SYMSIZE )
C
C======================================================================C
C Invalid symbol value C
C======================================================================C
C
Else
C
C======================================================================C
C Set error flag and return C
C======================================================================C
C
Error = 1
Ierr = symbol
Go To 9999
C
C======================================================================C
C End of if C
C======================================================================C
C
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine DrawTicks ( Axis, ticks, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram draws the tick marks on the screen. The axis C
C number of tick marks are passed from the calling program. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer C
C Axis - The axis number. C
C ticks - The number of tick marks to draw. C
C i - Do loop index variable. C
C Error - The error return value. C
C C
C Integer*4 C
C Ierr - The return error value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 5 => Invalid axis passed to this subprogram. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 Axis, ticks, i
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Determine if the X axis is the current axis C
C======================================================================C
C
If ( Axis .eq. XAXIS ) Then
C
C======================================================================C
C If it is, loop over all the tick marks C
C======================================================================C
C
Do ( i = 0, ticks )
C
C======================================================================C
C Draw the tick mark C
C======================================================================C
C
Call amiga (Move,RP,pixels(i),w_h-botoff )
Call amiga (Draw,RP,pixels(i),w_h-botoff+TKMK)
C
C======================================================================C
C End of loop C
C======================================================================C
C
End Do
C
C======================================================================C
C If the current axis is the Y axis C
C======================================================================C
C
Else If ( Axis .eq. YAXIS ) Then
C
C======================================================================C
C If it is, loop over all the tick marks C
C======================================================================C
C
Do ( i = 0, ticks )
C
C======================================================================C
C Draw the tick mark C
C======================================================================C
C
Call amiga ( Move, RP, lefoff, pixels(i) )
Call amiga ( Draw, RP, lefoff-TKMK, pixels(i) )
C
C======================================================================C
C End of loop C
C======================================================================C
C
End Do
C
C======================================================================C
C If the axis is not the X or the Y axis C
C======================================================================C
C
Else
C
C======================================================================C
C Signal an error C
C======================================================================C
C
Error = 5
Ierr = Axis
Go To 9999
C
End If
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine DrawLabels ( Axis, ticks, pltype, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram draws the labels on the screen. The axis, C
C number of tick marks, and plottype are passed from the calling C
C program. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*4 C
C Ierr - The integer error return value. C
C C
C Integer C
C x_modval - The modulus value used to determine if to draw a C
C label or not for the X axis. C
C y_modval - The modulus value used to determine if to draw a C
C label or not for the Y axis. C
C i - Do loop index variable. C
C Axis - The current axis being manipulated. C
C ticks - The number of tick marks in the data arrays. C
C pltype - The plot type being drawn. C
C tempx - A temporary storage location. C
C tempy - A temporary storage location. C
C Error - The return error value. C
C C
C Character C
C c_val - The character string that holds the label. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 5 => Invalid axis type. C
C Error = 8 => Invalid plot type. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 x_modval, y_modval, i, Axis, ticks, pltype, tempx, tempy
C
C======================================================================C
C Character variables C
C======================================================================C
C
Character
1 c_val*10
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Determine the spacing of the value labels C
C======================================================================C
C
If ( pltype .eq. LINEAR ) Then
x_modval = 2
y_modval = 1
Else If ( pltype .eq. LOG ) Then
x_modval = 9
y_modval = 9
Else
Error = 8
Ierr = pltype
Go To 9999
End If
C
C======================================================================C
C Loop over all tick marks C
C======================================================================C
C
Do ( i = 0, ticks )
C
C======================================================================C
C If the current axis is the X axis C
C======================================================================C
C
If ( Axis .eq. XAXIS ) Then
C
C======================================================================C
C Determine if this is one of the ones to write C
C======================================================================C
C
If ( mod(i,x_modval) .eq. 0 ) Then
C
C======================================================================C
C Convert the binary number to a character string C
C======================================================================C
C
Write ( c_val, 100 ) values(i)
C
C======================================================================C
C Draw the label on the screen C
C======================================================================C
C
tempx = pixels(i) - 40
tempy = w_h - botoff + 15
Call amiga ( Move, RP, tempx, tempy )
Call amiga ( Text, RP, c_val, 10 )
C
End If
C
C======================================================================C
C If the current axis is the Y axis C
C======================================================================C
C
Else If ( Axis .eq. YAXIS ) Then
C
C======================================================================C
C Determine if this is one of the ones to label C
C======================================================================C
C
If ( mod(i,y_modval) .eq. 0 ) Then
C
C======================================================================C
C Convert the binary number to a character string C
C======================================================================C
C
Write ( c_val, 100 ) values(i)
C
C======================================================================C
C Draw the label on the plot C
C======================================================================C
C
Call amiga ( Move, RP, 0, pixels(i)+4 )
Call amiga ( Text, RP, c_val, 10 )
C
End If
C
C======================================================================C
C If the current axis is not the X or Y axis C
C======================================================================C
C
Else
C
C======================================================================C
C Signal an error and return C
C======================================================================C
C
Error = 5
Ierr = Axis
Go To 9999
C
End If
C
End Do
C
C======================================================================C
C Format statements C
C======================================================================C
C
100 Format ( SP, 1pe10.3 ) ! +n.nnnE+nn
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine DrawGrid ( Axis, ticks, Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram draws the grid lines on the screen. The axis, C
C and the number of tick marks corresponding to the number C
C of grid lines are passed from the calling program. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer*2 C
C w_line - This is the line pattern used to draw the grid lines. C
C C
C Integer C
C i - Do loop index variable. C
C Axis - The current axis being manipulated. C
C ticks - The number of tick marks and hence the number of C
C grid lines. C
C Error - The returned error value. C
C C
C Integer*4 C
C Ierr - The error return value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C Error = 5 => Invalid Axis type. C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:graph.inc
Include include:plotdata.inc
C
C======================================================================C
C Integer*2 variables C
C======================================================================C
C
Integer*2
1 w_line(0:2)
C
C======================================================================C
C Integer variables C
C======================================================================C
C
Integer
1 i, Axis, ticks
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C======================================================================C
C Data statements C
C======================================================================C
C
Data
1 w_line / b'1000 1000 1000 1000',
2 b'1000 0000 1000 0000',
3 b'1111 1111 1111 1111' /
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Set the color to the gridline color C
C======================================================================C
C
Call amiga ( SetAPen, RP, gridline )
C
C======================================================================C
C Set the gridline line type C
C======================================================================C
C
word ( RP + 34 ) = w_line(Axis)
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
C
C======================================================================C
C If this is the X axis C
C======================================================================C
C
If ( Axis .eq. XAXIS ) Then
C
C======================================================================C
C Then draw all the grid lines C
C======================================================================C
C
Do ( i = 0, ticks )
Call amiga ( Move, RP, pixels(i), w_h-botoff )
Call amiga ( Draw, RP, pixels(i), topoff )
End Do
C
C======================================================================C
C If this is the Y axis C
C======================================================================C
C
Else If ( Axis .eq. YAXIS ) Then
C
C======================================================================C
C Then draw all the grid lines C
C======================================================================C
C
Do ( i = 0, ticks )
Call amiga ( Move, RP, lefoff, pixels(i) )
Call amiga ( Draw, RP, w_w-rigoff, pixels(i) )
End Do
C
C======================================================================C
C If it is not the X or Y axis C
C======================================================================C
C
Else
C
C======================================================================C
C Signal the error C
C======================================================================C
C
Error = 5
Ierr = Axis
Go To 9999
C
End If
C
C======================================================================C
C Reset the line type to a solid line C
C======================================================================C
C
word ( RP + 34 ) = w_line(2)
word ( RP + 32 ) = word ( RP + 32 ) .or. FRST_DOT
C
C======================================================================C
C Reset the color to white C
C======================================================================C
C
Call amiga ( SetAPen, RP, 1 )
C
C======================================================================C
C Return to the calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Subroutine DataGen ( Error, Ierr )
C
C======================================================================C
C C
C Purpose: C
C C
C This subprogram generates data based on data file input. C
C So far this calculates the scale factor, but is not used. It C
C also calculates the plotting borders against the plot borders. C
C C
C======================================================================C
C C
C Variables Definitions: C
C C
C Integer C
C Error - The error return value. C
C C
C Integer*4 C
C Ierr - The return error value. C
C C
C======================================================================C
C C
C Error Recovery: C
C C
C No error check C
C C
C======================================================================C
C
Implicit None
C
C======================================================================C
C Include files C
C======================================================================C
C
Include include:plotdata.inc
C
C======================================================================C
C Error variables C
C======================================================================C
C
Integer Error
Integer*4 Ierr
C
C**********************************************************************C
C Start of program C
C**********************************************************************C
C
C======================================================================C
C Determine the scale factor - y/x C
C======================================================================C
C
SF = w_h / w_w
C
C======================================================================C
C Determine plot size in relation to the axis size C
C======================================================================C
C
p_loff = lefoff + lefpt
p_roff = rigoff + rigpt
p_toff = topoff + toppt
p_boff = botoff + botpt
C
C======================================================================C
C Return to calling program C
C======================================================================C
C
9999 Continue
Return
End
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++